home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
System source
/
qd
< prev
next >
Wrap
Text File
|
1994-06-24
|
4KB
|
146 lines
\ Modification History - QuickDraw Objects
\ 4/27/84 CBD Version 1.00
\ 8/16/84 CBD Changed Set: to SetText for GrafPort
\ 8/16/84 CBD Added Point methods, savePort
\ 10/25/84 CBD Added Image, Picture
\ 11/02/84 CBD Moved image, picture to qdExt
\ 11/22/84 cbd Renamed bitMap qdBitMap
\ 11/23/84 cbd Added Random
\ 12/14/84 cbd Trimmed down for release 1.0
\ 11/16/85 cdn Added disp: method to Rect
\ 12/13/91 rfl added ptin: method to Rect
0 Constant srcCopy \ Equates for drawing modes
1 Constant srcOr
2 Constant srcXor
\ Random - returns a random number 0 - N. N is limited to an Int
\ value. Larger than that means that numbers will be poorly distributed
( n -- rand*N )
: Random word0 call Random word0 swap mod ;
:CLASS Point <Super Object
Int Y \ Vertical coordinate
Int X \ Horizontal coordinate
:M GETX: get: X ;M
:M GETY: get: Y ;M
:M GET: get: X get: Y ;M ( -- x y )
:M PUT: put: Y put: X ;M
:M PUTX: put: X ;M
:M PUTY: put: Y ;M
:M INT: M@ ;M \ leave a long with x:y
;CLASS
:CLASS Rect <Super Object
Point TopL
Point BotR
:M GET: get: TopL get: BotR ;M ( -- l t r b )
:M PUT: put: BotR put: TopL ;M ( l t r b -- )
:M GETTOP: get: TopL ;M
:M GETTOPX: getX: TopL ;M
:M GETTOPY: getY: TopL ;M
:M PUTTOP: put: TopL ;M
:M PUTTOPX: putX: TopL ;M
:M PUTTOPY: putY: TopL ;M
:M GETBOT: get: BotR ;M
:M GETBOTX: getX: BotR ;M
:M GETBOTY: getY: BotR ;M
:M PUTBOT: put: BotR ;M
:M PUTBOTX: putX: BotR ;M
:M PUTBOTY: putY: BotR ;M
:M DRAW: abs: Self call FrameRect ;M
:M DISP: put: self draw: self ;M
:M PRINT: draw: Self ;M
:M CLEAR: abs: Self call EraseRect ;M
\ ( addr -- ) copy rect's values to address on stack
:M =: ^Base swap 8 cmove ;M
\ ( ^patObj -- ) Fill rect with pattern
:M FILL: +base abs: self swap call FillRect ;M
\ ( -- width height ) calc rect's size
:M SIZE: getx: botr getx: topl - \ compute w
gety: botr gety: topl - ;M
\ ( -- x y )
:M CENTER: { \ x y -- } Size: Self 2/ -> y 2/ -> x
GetX: TopL x + getY: topL y + ;M
\ ( -- )
:M INVERT: (abs) call InverRect ;M
\ ( -- )
:M PAINT: (abs) call PaintRect ;M
\ ( -- ) clip drawing to this rect
:M CLIP: (abs) call ClipRect ;M
\ ( -- ) add rect to update region
:M UPDATE: (abs) call InvalRect ;M
\ ( dh dv -- ) Make rect smaller by dh dv
:M INSET: pack (abs) swap call InsetRect ;M
\ ( dh dv -- )
:M OFFSET: pack abs: self swap call OffsetRect ;M
\ ( point -- b)
:M PTIN: 0 swap (abs) call PtInRect unpack swap drop 256 = ;M
\ show an example of a Rect
:M EXAMPLE: 50 50 200 150 Put: self Draw: self ;M
;CLASS
' Rect 'c fpRect !
\ A temporary rectangle, usable by anything
Rect tempRect
:CLASS Grafport <Super Object
16 Bytes graf1 \ unmapped
Rect Portrect
44 Bytes graf3
Var Text1 \ font,face,mode,size
Var Text2
32 Bytes graf2 \ unmapped
\ ( -- ) Make this GrafPort current
:M SET: (abs) call SetPort ;M
\ ( l t r b -- ) Get values for port Rect
:M GETRECT: Get: portrect ;M
\ ( l t r b -- ) store values for portrect
:M PUTRECT: Put: PortRect ;M
;CLASS
: pushPort 0 sp@ +base call GetPort ;
: popPort call SetPort ;
\ cursors are simple data types that set themselves
1 codefields
Do.. 0 swap w@ makeInt call GetCursor >ptr +base call SetCursor ..End
\ use: resID cursor sam
: Cursor Build w, ..End
\ predefined cursors
1 cursor iBeamCurs
2 cursor crossCurs
3 cursor plusCurs
4 cursor watchCurs
: arrowCurs call InitCursor ;
'type PAT# 0 rsrc spList \ system pattern list
\ ( pat# -- ^pattern ) return ptr to standard Mac pattern
: sysPat 8 * spList 2+ + ;